home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / prowho19.zip / PROWHO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-09  |  4KB  |  180 lines
  1.  
  2. (*
  3.  * ProWho.PAS - Door to answer the question: Who uploaded that file?
  4.  *
  5.  * (C) 1988 Samuel H, Smith (05-Feb-88)
  6.  *
  7.  *)
  8.  
  9. {$M 12000,12000,12000}  {Stack, minheap, maxheap}
  10. {$V-}                   {Relax string rules}
  11.  
  12. Program WhoUploaded;
  13.  
  14. {$i prokit.inc}    {include standard 'uses' statement}
  15.  
  16. const
  17.    version = 'ProWho v1.9ß, 03-09-91 (C)1991 S.H.Smith';
  18.  
  19.    shortest = 2;        {shortest search key allowed}
  20.  
  21. var
  22.    buffer:              array[1..20480] of char;
  23.  
  24.    driver:              string;   {driver type; taken care of automatically}
  25.    download_file:       string;   {download listing file}
  26.    welcome_file:        string;   {welcome message file}
  27.    menu_file:           string;   {main menu file}
  28.    close_file:          string;   {closing message file}
  29.  
  30.  
  31. (* ---------------------------------------------------------------- *)
  32. procedure load_info;
  33.    {load the latest configuration file}
  34. var
  35.    fd: text;
  36. begin
  37.    assignText(fd,config_file);
  38.    reset(fd);
  39.    readln(fd,driver);
  40.    readln(fd,download_file);
  41.    readln(fd,welcome_file);
  42.    readln(fd,menu_file);
  43.    readln(fd,close_file);
  44.    close(fd);
  45. end;
  46.  
  47.  
  48. (* ---------------------------------------------------------------- *)
  49. procedure locate_file(name: string);
  50.    {$i \tinc\bline.inc}
  51. var
  52.    table:  Btable;
  53.    fd:     text;
  54.    line:   string;
  55.    uline:  string;
  56.    i:      longint;
  57.    recs:   longint;
  58.    downs:  longint;
  59.    ups:    longint;
  60.    hits:   longint;
  61.  
  62.    procedure scanfile;
  63.    begin
  64.       MakeTable(name,table);
  65.  
  66.       while true do
  67.       begin
  68.          qReadLn(fd,line,sizeof(line));
  69.          if dump_user or (line[1] = ^Z) then exit;
  70.  
  71.          inc(recs);
  72.          if (recs mod 300) = 0 then
  73.          begin
  74.             if nomore then exit;
  75.             disp('.');
  76.          end;
  77.  
  78.          i := BMsearch(line[1],length(line), table, name);
  79.          if i > 0 then
  80.          begin
  81.             if nomore then exit;
  82.  
  83.             displn(^M+aWHITE+copy(line,1,i-1)+
  84.                       aRED  +name+
  85.                       aWHITE+copy(line,i+length(name),255));
  86.  
  87.             inc(hits);
  88.             if pos('(U)',uline) > 0 then inc(ups);
  89.             if pos('(D)',uline) > 0 then inc(downs);
  90.          end;
  91.  
  92.       end;
  93.    end;
  94.  
  95. begin
  96.    AssignText(fd,download_file);
  97.    {$i-} reset(fd); {$i+}
  98.    if ioresult <> 0 then
  99.    begin
  100.       displn(aRED+'Can''t access data file.  Sorry!');
  101.       exit;
  102.    end;
  103.  
  104.    SetTextBuf(fd,buffer);
  105.    downs := 0;
  106.    ups := 0;
  107.    hits := 0;
  108.    recs := 0;
  109.    stoupper(name);
  110.    make_log_entry('Searching for ('+name+') ...',true);
  111.    newline;
  112.  
  113.    scanfile;
  114.  
  115.    close(fd);
  116.    newline;
  117.  
  118.    disp(aGREEN+itoa(recs)+' entries scanned, '+itoa(hits)+' matches');
  119.    if ups > 0 then   disp(', '+itoa(ups)+' uploads');
  120.    if downs > 0 then disp(', '+itoa(downs)+' downloads');
  121.    displn('.');
  122.  
  123.    newline;
  124. end;
  125.  
  126.  
  127. (* ---------------------------------------------------------------- *)
  128. procedure main_menu;
  129.    {main procedure}
  130. begin
  131.  
  132.    repeat
  133.       force_enter;
  134.       display_file(menu_file);
  135.  
  136.       display_time_left;
  137.       disp('Enter the Text to Scan for: (Q)=quit? ');
  138.  
  139.       get_cmdline;              {get cmdline, map to upper case}
  140.       newline;
  141.  
  142.       if cmdline = 'Q' then
  143.          exit;
  144.  
  145.       if length(cmdline) < shortest then
  146.          displn('Please enter a longer search key!')
  147.       else
  148.       if is_wild(cmdline) then
  149.          displn('Wildcards won''t work!  Use keywords only.')
  150.       else
  151.          locate_file(cmdline);
  152.  
  153.    until dump_user or (minutes_left < 1);
  154.  
  155. end;
  156.  
  157.  
  158. (* ---------------------------------------------------------------- *)
  159.  
  160. begin  {main block}
  161.    init;     {must be first - opens com port, loads setup and user data}
  162.  
  163.    newline;
  164.    displn(version);
  165.    load_color_constants('PROCOLOR');
  166.                             {use 'PROCOLOR' to redefine colors; defaults used
  167.                              if this file is missing}
  168.  
  169.    progname := 'ProWho';    {program name on status line, must be 7 characters}
  170.    load_info;               {load info from config file}
  171.  
  172.    display_file(welcome_file);
  173.  
  174.    main_menu;              
  175.    display_file(close_file);
  176.  
  177.    uninit;   {must be last - closes com port and updates database}
  178. end.
  179.  
  180.